(in-package :elephant-tests)

(in-suite* test-slot-sets :in elephant-tests)

(test set-valued-slots-basic
  (finishes
    (defpclass svs-obj ()
      ((foo :set-valued t))))
  
  (let (svso1 svso2 svso3)
    (finishes (setf svso1 (make-instance 'svs-obj))) ; create
    
    
    (is (null (set-list svso1 'foo))) ;initial
    (finishes (set-insert 1 svso1 'foo)) ; insert
    (is (equal (set-list svso1 'foo) '(1)))
    (finishes (set-insert 1 svso1 'foo)) ; repeated insert (set, not sequence)
    (is (equal (set-list svso1 'foo) '(1)))
    (finishes (set-insert 2 svso1 'foo)) ; insert different
    (is (null (set-difference (set-list svso1 'foo)
			      '(1 2))))
    
    (finishes (setf svso2 (make-instance 'svs-obj))) ; second object
    (is (null (set-list svso2'foo)))
    (finishes (set-insert "a" svso2 'foo)) ; insert string
    (is (equal (set-list svso2 'foo) '("a")))
    (finishes (set-insert "a" svso2 'foo)) ; repeated insert string
    (is (equal (set-list svso2 'foo) '("a")))
    (finishes (set-insert 2 svso2 'foo)) ; mixed values
    (is (null (set-difference (set-list svso2 'foo)
			      '("a" 2)
			      :test #'equal)))
    (is (null (set-difference (set-list svso1 'foo) ; object independent
			      '(1 2))))
    
    (finishes (set-remove "a" svso2 'foo)) ; remove
    (is (equal (set-list svso2 'foo) '(2)))
    (finishes (set-remove "b" svso2 'foo)) ; remove non-existent
    (is (equal (set-list svso2 'foo) '(2)))
    
    (setf svso3 (make-instance 'svs-obj)) ; persistent objects
    (finishes (set-insert svso1 svso3 'foo))
    (finishes (set-insert svso1 svso3 'foo))
    (finishes (set-insert svso2 svso3 'foo))
    (is (null (set-difference (set-list svso3 'foo)
				(list svso1 svso2))))))


(test (set-valued-slots-api :depends-on set-valued-slots-basic)
  (finishes
   (defpclass svs-obj-a ()
     ((foo :accessor foo-of :set-valued t))))
  
  (let (svso)
    (finishes (setf svso (make-instance 'svs-obj-a)))
    (is (not (null (foo-of svso)))) ; accessor, lazy initialization
    (finishes (insert-item 1 (foo-of svso))) ; insert-item
    (finishes (insert-item 2 (foo-of svso)))
    (is (not (null (find-item 1 (foo-of svso))))) ; find-item
    (is (not (null (find-item 2 (foo-of svso)))))
    (is (null (find-item 3 (foo-of svso))))
    (finishes (remove-item 3 (foo-of svso))) ; remove-item
    (finishes (remove-item 2 (foo-of svso)))
    (is (null (find-item 2 (foo-of svso))))
    (is (equal (slot-set-list (foo-of svso)) '(1))) ; slot-set-list
    
    ;; "weird" API
    (finishes (setf (foo-of svso) 4))
    (is (not (null (find-item 4 (foo-of svso)))))
    
    (let ((contents (list 1 4))) ; map-slot-set
      (map-slot-set (lambda (v) 
		      (is (member v contents))
		      (setf contents (remove v contents)))
		    (foo-of svso))
      (is (null contents)))))

(test (set-valued-slots-replace :depends-on set-valued-slots-api)
  (finishes
   (defpclass svs-obj-a ()
     ((foo :accessor foo-of :set-valued t))))
  
  (let ((svso1 (make-instance 'svs-obj-a))
	(svso2 (make-instance 'svs-obj-a))
	(svso3 (make-instance 'svs-obj-a)))
    (set-insert 1 svso1 'foo)
    (set-insert 2 svso1 'foo)
    (set-insert 3 svso2 'foo)
    (set-insert 4 svso2 'foo)
    
    (finishes (setf (foo-of svso2) (foo-of svso1)))

    (is (null (set-difference (set-list svso2 'foo) '(1 2))))
    (is (null (set-difference (set-list svso1 'foo) '(1 2))))

    (set-insert 3 svso2 'foo)
    (set-remove 2 svso1 'foo)
    
    (is (null (set-difference (set-list svso2 'foo) '(1 3))))
    (is (null (set-difference (set-list svso1 'foo) '(1 3))))))


(test (set-valued-slots-null :depends-on set-valued-slots-api)
  (finishes
   (defpclass svs-obj-a ()
     ((foo :accessor foo-of :set-valued t))))
  
  (let ((svso (make-instance 'svs-obj-a)))
    (set-insert 1 svso 'foo)
    (set-insert 2 svso 'foo)
    (setf (foo-of svso) nil)

    (is (null (foo-of svso)))

    (signals error (set-insert 1 svso 'foo))))
